home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue47 / IntBase / UnitConsoleInterface.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1999-05-04  |  7.3 KB  |  323 lines
  1. unit UnitConsoleInterface;
  2.  
  3. interface
  4.  
  5. uses SysUtils, frs_Ibase, frs_Ibase_Object, frs_IBStartParams
  6.     , UnitAttachDB
  7.     , UnitUserInfo
  8.     , UnitQueryDB
  9.     ;
  10.  
  11. procedure ConsoleMenu;
  12.  
  13. implementation
  14.  
  15. procedure SetMenu;
  16. begin
  17.   with frs_GDS do begin
  18.     writeln('InterBase API Demonstration project.');
  19.     writeln('Choose an option and then press <Enter>.');
  20.     writeln;
  21.   if not assigned(DBHandle) then begin
  22.     writeln(#9,'Open Database'#9#9'O');
  23.     writeln(#9,'Set Buffers and open db'#9'B');
  24.     writeln;
  25.     end
  26.   else begin
  27.     writeln(#9,'List Usernames'#9#9'U');
  28.     writeln;
  29.     writeln(#9,'View employees'#9#9'V');
  30. //    writeln(#9,'Alter employee info'#9'A');
  31.     writeln;
  32.     writeln(#9,'Dynamic Query'#9#9'S');
  33.     writeln;
  34.   end;
  35.     writeln(#9,'Exit'#9#9#9'X');
  36.     write('>');
  37.   end;
  38. end;
  39.  
  40. Procedure SetHelpScreen;
  41. begin
  42.   writeln('InterBase API Demonstration project.');
  43.   writeln;
  44.   writeln('Create a shortcut and enter the location of employee.gdb as follows:');
  45.   writeln;
  46.   writeln(#9'/d Database name ie Path\employee.gdb');
  47.   writeln(#9'/s ServerName ie myserver');
  48.   writeln;
  49.   writeln(#9'/n Network protocol:');
  50.   writeln(#9#9'0 - NetBeui');
  51.   writeln(#9#9'1 - IPX/SPX');
  52.   writeln(#9#9'2 - TCP/IP');
  53.   writeln(#9#9'3 - Local');
  54.   writeln;
  55.   writeln(#9'/u - username');
  56.   writeln(#9'/p - password');
  57.   writeln;
  58.   writeln(#9'eg /d c:\data\employee.gdb /s myserver /n 0 -u SYSDBA -p masterkey');
  59.   writeln;
  60.   writeln('Hit <enter> to continue.');
  61.   writeln;
  62. end;
  63.  
  64. Function GetBuffers: Integer;
  65. var
  66.   BufferStr: String;
  67. begin
  68.   BufferStr:='0';
  69.   Write('Enter buffers to set (64-64000) and press <enter> : ');
  70.   repeat
  71.     ReadLn(BufferStr);
  72.     try
  73.       Result:=StrToInt(BufferStr);
  74.     except
  75.       Result:=0;
  76.     end;
  77.   until
  78.     Result<>0;  
  79. end;
  80.  
  81.  
  82. procedure SetErrorScreen;
  83. var
  84.   ErrStr: String;
  85. begin
  86.   ErrStr:=frs_GDS.ErrorMessages;
  87.   Writeln('Fatal Error encountered:');
  88.   Writeln;
  89.   Writeln(ErrStr);
  90.   Writeln;
  91.   Writeln('Press X followed by <enter> to exit');
  92. end;
  93.  
  94. Procedure OpenDb;
  95. begin
  96.   try 
  97.     UnitAttachDB.Open;
  98.     WriteLn('Database opened.');
  99.     Writeln;
  100.     SetMenu;
  101.   except
  102.     SetErrorScreen;
  103.   end;
  104. end;
  105.  
  106. procedure DisplayUsers;
  107. var
  108.   UserNames: TLargePB;
  109.   UserCount: Integer;
  110.   
  111.   i,
  112.   Item,           //InfoItem we are testing for  
  113.   Pos,            //marker for position in array
  114.   Len,            //Length of section
  115.   namelength: SmallInt;    
  116.   UserStr: array[0..255] of char;
  117. begin
  118.   Fillchar(UserNames,sizeof(UserNames),#1);
  119.   try
  120.     UnitUserInfo.GetUserInfo(UserNames);
  121.     
  122.   (* Usernames will now have data in the following format:
  123.   
  124.     '5',                            //Info type - isc_info_user_name
  125.     #6, #0,                         //Number of bytes in next section
  126.     #5,                             //length of name
  127.     'G', 'U', 'E', 'S', 'T',        //name
  128.     '5',                            //Info type - isc_info_user_name
  129.     #7, #0,                         //Number of bytes in next section
  130.     #6,                             //length of name  
  131.     'S', 'Y', 'S', 'D', 'B', 'A',   //name
  132.  
  133.       etc. etc.
  134.       
  135.     #1,                             //isc_info_end (hopefully)
  136.  
  137.   *)
  138.   
  139.   writeln('The following users are currently connected:');
  140.   writeln;
  141.   item:=0;
  142.   UserCount:=0;  
  143.   
  144.   while not ((((UserNames[item])=char(isc_info_end)) OR
  145.       ((UserNames[item])=char(isc_info_error))) OR
  146.       ((UserNames[item])=char(isc_info_truncated))) do begin
  147.       
  148.     pos:=item;                                            //isc_info_user_name   
  149.     inc(pos);                                             //start of length byte pair
  150.     len:=frs_GDS.isc_vax_integer(@UserNames[pos],2);      //read the two-byte length and save it for Ron.
  151.     inc(pos,2);                                           //move forward to byte telling us length of name   
  152.     UserStr:='';
  153.     NameLength:=byte(UserNames[pos])+1;
  154.     fillChar(UserStr,256,#0);
  155.     for i:=1 to namelength-1 do
  156.       UserStr[i-1]:=UserNames[pos+i];
  157.     writeln(#9,UserStr);
  158.     inc(UserCount);
  159.     inc(item,len+3);{move to next item  (3 covers length of item (one byte) and len (two bytes)}
  160.     
  161.   end;
  162.   writeln;
  163.   WriteLn(IntToStr(UserCount),' users');
  164.     
  165.   except
  166.     writeln('Error retrieving user info: ');
  167.     Writeln;
  168.     Writeln(frs_GDS.ErrorMessages);
  169.   end;
  170.   Writeln;
  171.   SetMenu;
  172. end;
  173.  
  174. Procedure SelectEmployeeList;
  175. var 
  176.   keypress: Char;
  177.   SelectStr: String;
  178.   ResultStr: String;
  179. begin
  180. SelectStr:= 'select emp_no, full_name, Salary '+
  181.             'from employee where last_name starting with upper(?)'+
  182.             'order by last_name';
  183.  
  184. with frs_GDS do begin
  185.   TransactionStart;
  186.   UnitQueryDB.PrepareStatement(SelectStr);
  187.   writeln('What letter does the last name start with?');
  188.   keypress:=#0;
  189.   repeat
  190.     read(keypress);
  191.   until
  192.     upcase(keypress) in ['A'..'Z'];
  193.   UnitQueryDB.AssignParam(keypress,0);
  194.   UnitQueryDb.ExecuteStatement;
  195.   writeln;
  196.  
  197.   //now get the column titles
  198.   ResultStr:=UnitQueryDb.ReadTitles;
  199.   writeln(ResultStr);
  200.   writeln;
  201.  
  202.   //now get the results, row by row
  203.   ResultStr:='';
  204.   repeat
  205.     ResultStr:=ReadRow;
  206.     writeln(ResultStr);
  207.   until
  208.     ResultStr='';
  209.  
  210.   //cleanup
  211.   TransactionCommit;
  212.   UnitQueryDb.UnprepareStatement;
  213.       
  214.   
  215. end;
  216.  
  217. SetMenu;
  218.  
  219. end;
  220.  
  221. procedure RunDynamicSelect;
  222. var
  223.   SelectStr: String;
  224.   ResultStr: String;
  225. begin
  226.  
  227. writeln('Enter Select statement:');
  228. repeat
  229.   readln(SelectStr);
  230. until
  231.   (SelectStr<>'');
  232.  
  233.   //test if select. reject if not
  234. if  'select'=lowercase(copy(SelectStr,1,6)) then
  235.   
  236.   with frs_GDS do begin
  237.     TransactionStart;
  238.     UnitQueryDB.PrepareStatement(SelectStr);
  239.     UnitQueryDb.ExecuteStatement;
  240.     writeln;
  241.  
  242.     //titles
  243.     writeln(UnitQueryDb.ReadTitles);
  244.     writeln;
  245.  
  246.     //now get the results, row by row
  247.     ResultStr:='';
  248.     repeat
  249.       ResultStr:=ReadRow;
  250.       writeln(ResultStr);
  251.     until
  252.       ResultStr='';
  253.       
  254.     writeln;
  255.  
  256.     //cleanup
  257.     TransactionCommit;
  258.     UnitQueryDb.UnprepareStatement;
  259.       
  260.   end
  261.   
  262. else
  263.   writeln('You must enter a valid Select statement.');
  264.  
  265. Writeln;
  266. SetMenu;
  267.   
  268. end;
  269.  
  270.  
  271. procedure ConsoleMenu;
  272. var
  273.   keypress: Char;
  274. begin
  275.  
  276.   keypress:=#0;
  277.   //if no database specified then display help screen
  278.   with IBStartupParams do 
  279.     if IBDatabase='' then 
  280.       DisplayHelp:=True;
  281.       
  282.   if (IBStartupParams.DisplayHelp=True) then begin
  283.     SetHelpScreen;
  284.     while keypress<>#13 do
  285.       read(keypress);
  286.     end
  287.   else begin
  288.     SetMenu;
  289.     repeat
  290.       read(keypress);
  291.       case UpCase(keypress) of
  292.  
  293.         'O' : OpenDB;
  294.  
  295.         'B' : begin
  296.                 IBStartUpParams.IBBuffers:=GetBuffers;
  297.                 OpenDb;
  298.                 Writeln(IntToStr(IBStartUpParams.IBBuffers)+' buffers set.');
  299.               end;
  300.  
  301.         'U' : DisplayUsers;
  302.                      
  303.         'V' : SelectEmployeeList;
  304.                      
  305. //        'A' : AmendEmployeeDetails;
  306.                      
  307.         'S' : RunDynamicSelect;
  308.                      
  309.         'X' : begin
  310.                 UnitAttachDB.close;
  311.                 WriteLn('Database attachment closed.');
  312.                 Writeln;
  313.               end;
  314.       end;  
  315.     until
  316.       UpCase(keypress)='X';
  317.       
  318.   end;
  319.  
  320. end;
  321.  
  322. end.
  323.